﻿
Imports System.Threading
Imports std
Imports threadpoolCommon

Public Interface ithreadpool
    Sub disableTimeLimitOperation()
    Sub enableTimeLimitOperation()
    Sub insertJob(ByVal work As ParameterizedThreadStart, ByVal obj As Object)
    Sub insertJob(ByVal obj As Object)
    Property threadCount() As Int64
    Function stopping() As Boolean
    Sub [stop](Optional ByVal stopWaitSeconds As Int64 = defaultStopWaitSeconds)
End Interface

Namespace threadpoolCommon
    Public Class workInfo
        Public ReadOnly ctor_ticks As Int64 = 0
        Public work As ParameterizedThreadStart = Nothing
        Public para As Object = Nothing

        Public Sub New(ByVal work As ParameterizedThreadStart, ByVal para As Object)
            Me.work = work
            Me.para = para
            If _threadpool.needtrace Then
                Me.ctor_ticks = Now.ticks()
            End If
        End Sub
    End Class

    Public Module _threadpool
        Public Const defaultStopWaitSeconds As Int32 = 30
        Public ReadOnly needtrace As Boolean = False
        Private THREADPOOL_WORKINFO_INQUEUE_TICKS As Int64

        Sub New()
            needtrace = envs.perftrace() OrElse
                        envs.env_value(New String() {"threadpool_trace",
                                                     "tptrace",
                                                     "threadpooltrace",
                                                     "THREADPOOL_TRACE",
                                                     "TPTRACE",
                                                     "THREADPOOLTRACE"}, Nothing)
            THREADPOOL_WORKINFO_INQUEUE_TICKS =
                counter.registerAverageAndLastAverage("THREADPOOL_WORKINFO_INQUEUE_TICKS")
        End Sub

        Public Function defaultThreadCount() As Int64
            Return ifoper(Environment.ProcessorCount() < 2, 2, Environment.ProcessorCount().asint64())
        End Function

        Public Sub workOn(ByVal obj As workInfo,
                          Optional ByRef workingThread As Int32 = 0,
                          Optional ByVal timelimitOperationEnabled As Boolean = False)
            If obj.work Is Nothing Then
                raiseError("do not get workthreadDelegate from job queue, ignore this request.", _
                           errorHandle.errorType.warning)
            Else
                If needtrace Then
                    counter.recordTimeTicks(THREADPOOL_WORKINFO_INQUEUE_TICKS, obj.ctor_ticks)
                End If
                Interlocked.Increment(workingThread)
                If timelimitOperationEnabled Then
                    timelimitOperation.start()
                End If
                void_(Sub()
                          obj.work(obj.para)
                      End Sub)
                If timelimitOperationEnabled Then
                    timelimitOperation.finish(New lazier(Of String)(Function() As String
                                                                        Return invokeMethodIdentity(obj.work)
                                                                    End Function))
                End If
                Interlocked.Decrement(workingThread)
            End If
        End Sub

        Public Sub register()
            threadpool.register()
        End Sub

        Public Sub register(ByVal resolver As resolver)
            threadpool.register(resolver)
        End Sub

        Private Sub stopThread(ByVal thread As Thread, ByRef stopWaitSeconds As Int64)
            Dim startticks As Int64 = Now.ticks()
            Try
                thread.Abort()
                thread.Join(secondsToMilliseconds(stopWaitSeconds))
            Catch
            Finally
                stopWaitSeconds -= ticksToSeconds(Now.ticks() - startticks)
            End Try
        End Sub

        Private Sub stopImpl(ByVal threads() As Thread,
                             ByVal stopWaitSeconds As Int64,
                             ByVal before As void,
                             ByVal after As void)
            If stopWaitSeconds <= 0 Then
                stopWaitSeconds = defaultStopWaitSeconds
            End If
            raiseError("threadpool starts to stop, running before step.")
            void_(before)
            If Not threads Is Nothing AndAlso threads.Length() > 0 Then
                Dim i As Int64
                For i = 0 To threads.Length() - 1
#If Not (PocketPC OrElse Smartphone) Then
                    If Not threads(i) Is Nothing AndAlso threads(i).IsAlive() Then
                        stopThread(threads(i), stopWaitSeconds)
                    End If
#Else
                If Not threads(i) Is Nothing Then
                    stopThread(threads(i), stopWaitSeconds)
                End If
#End If
                Next
            End If
            void_(after)
            raiseError("threadpool finished stopping.")
        End Sub

        Public Sub [stop](ByVal threads() As Thread,
                          ByVal stopWaitSeconds As Int64,
                          Optional ByVal before As void = Nothing,
                          Optional ByVal after As void = Nothing)
            assert(Not threads Is Nothing)
            Dim s As ThreadStart = Sub()
                                       stopImpl(threads, stopWaitSeconds, before, after)
                                   End Sub
            For i As Int64 = 0 To threads.Length() - 1
                If object_compare(threads(i), Thread.CurrentThread()) = 0 Then
                    startThread(s)
                    Return
                End If
            Next
            s()
        End Sub

        Public Sub [stop](ByVal threads As vector(Of Thread),
                          ByVal stopWaitSeconds As Int64,
                          Optional ByVal before As void = Nothing,
                          Optional ByVal after As void = Nothing)
            assert(Not threads Is Nothing)
            [stop](+threads, stopWaitSeconds)
        End Sub
    End Module
End Namespace
